home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / earth_ss / earth01.pas < prev   
Pascal/Delphi Source File  |  1996-09-15  |  23KB  |  808 lines
  1. {>
  2.   This program EARTH.EXE (then copied to EARTH.SCR) is a small screen
  3.   saver example. It displays a moving earth in the sky. The EARTH.EXE
  4.   program can also be run as a normal Windows application; in that case,
  5.   the earth will move in a variable size window, as determined by the
  6.   user.
  7.  
  8.   The same main form, 'f_ScreenSaver', is here used to run the screen
  9.   saver in four different modes: execution (screen saver or normal
  10.   Windows application) and configuration (from Windows screen saver
  11.   installation option or normal Windows application).
  12.  
  13.   When the program runs as a normal Windows application, clicking in the
  14.   main window will call the installation screen. In that latter mode,
  15.   the application's icon will change every second when minimized as an
  16.   icon.
  17.  
  18.   When the screen saver is executed, a little trick is used to prepare
  19.   a surface on which we will draw the moving earth: the main window panel,
  20.   'BackPanel', is made invisible and the main window is resized to use
  21.   all the screen surface. In that case, we can then copy a earth bitmap on
  22.   the form canvas, and all other controls that are only useful when the
  23.   program is run in configuration mode are hidden.
  24.  
  25.   The code contains everything you need to display the configuration
  26.   window and save the parameters to a file. These parameters are
  27.   read back at execution time.
  28.  
  29.   Note that you need a $D directive in the main project source file,
  30.   such as 'EARTH.DPR'. It is in this file that the .EXE name is set to
  31.   'Earth'. It is also in the .DPR file that we have to specify
  32.   to NOT execute the program twice (Windows may start the Screen Saver
  33.   even when it is active).
  34.  
  35.   To install, rebuild the EARTH application, then copy the resulting
  36.   file 'EARTH.EXE' to your Windows directory ('C:\WINDOWS', say)
  37.   under the name 'EARTH.SCR', then use the Configuration Panel (Desktop)
  38.   to select and possibly configure this new screen saver. You can also
  39.   run the normal .EXE file as a normal Windows application.
  40.  
  41.   All the code is documented below, so modifying it should be very easy.
  42.   My own comments are introduced with '{>'.
  43.  
  44.   This code is freeware. However, you can always send me an e.mail to let
  45.   me know that you got it. It is always nice to know that something we
  46.   contributed is actually used...! All the very best and have fun.
  47.  
  48.   Jacques Lemieux
  49.   BΘluga Soft Information, MontrΘal, QuΘbec
  50.   Compuserve: 72470,1055
  51.   Internet: 72470.1055@compuserve.com
  52. }
  53.  
  54. unit Earth01;
  55.  
  56. interface
  57.  
  58. uses
  59.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  60.   Forms, Dialogs, ExtCtrls, StdCtrls ;
  61.  
  62. type
  63.   Tf_ScreenSaver = class(TForm)
  64.     BackPanel: TPanel;
  65.     SaveButton: TButton;
  66.     TimerEarth: TTimer;
  67.     Earth: TImage;
  68.     FastCheckbox: TCheckBox;
  69.     ShowSkyCheckBox: TCheckBox;
  70.     UseColorsCheckBox: TCheckBox;
  71.     UseMoreStarsCheckBox: TCheckBox;
  72.     TransparentCheckBox: TCheckBox;
  73.     PR1: TLabel;
  74.     PR2: TLabel;
  75.     ExitButton: TButton;
  76.     Icon1: TImage;
  77.     Icon2: TImage;
  78.     Icon3: TImage;
  79.     Icon4: TImage;
  80.     TimerIcon: TTimer;
  81.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  82.       Y: Integer);
  83.     procedure FormCreate(Sender: TObject);
  84.     procedure TimerEarthTimer(Sender: TObject);
  85.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  86.     procedure SaveButtonClick(Sender: TObject);
  87.     procedure ExitButtonClick(Sender: TObject);
  88.     procedure ShowSkyCheckBoxClick(Sender: TObject);
  89.     procedure FormResize(Sender: TObject);
  90.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  91.     procedure FormPaint(Sender: TObject);
  92.     procedure FormClick(Sender: TObject);
  93.     procedure StartSaver ;
  94.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  95.     procedure TimerIconTimer(Sender: TObject);
  96.   private
  97.     { Private declarations }
  98.     {> Read, Write the parameters block }
  99.     function WinDir : string ;
  100.     procedure read_config ;
  101.     procedure write_config ;
  102.     {> Setup procedure }
  103.     procedure Setup ;
  104.     {> Check consistency of checkboxes }
  105.     procedure check_checkboxes ;
  106.     {> Compute move factor }
  107.     function move_factor : integer ;
  108.     {> Stars handling stuff for execution mode }
  109.     function StarColor : TColor ;
  110.     procedure ComputeSky ;
  111.  public
  112.     { Public declarations }
  113.   end;
  114.  
  115. var
  116.   f_ScreenSaver: Tf_ScreenSaver;
  117.  
  118. implementation
  119.  
  120. {$R *.DFM}
  121.  
  122. {> Transform all I/O errors in exceptions
  123. }
  124. {$I+}
  125.  
  126. {> Constants & Types }
  127.  
  128. const INIT_FILE = 'M_EARTH.DAT' ;       {> Name of parameters file }
  129.  
  130. type RunMode = (rm_ScreenSaver, rm_ConfigWindows,
  131.                 rm_ConfigNormal, rm_Normal) ;
  132.  
  133.      config_params = record             {> screen saver parameters }
  134.                        fast : boolean ;
  135.                        show_sky : boolean ;
  136.                        use_colors : boolean ;
  137.                        use_more_stars : boolean ;
  138.                        transparent : boolean ;
  139.                        x, y : integer ;
  140.                        width, height : integer ;
  141.                      end ;
  142.  
  143. {> Global variables }
  144.  
  145. var gl_params : config_params ;    {> Configuration parameters }
  146.     gl_old_mouse_pos : TPoint ;    {> Mouse position at beginning }
  147.     gl_mode : RunMode ;            {> Current running mode }
  148.     gl_original_width,             {> Original width, height as designed }
  149.     gl_original_height : integer ;
  150.     gl_icons : array [1..4] of TIcon ; {> Icons used when form minimized }
  151.     gl_next_icon : integer ;       {> Next icon number to use }
  152.  
  153. procedure Tf_ScreenSaver.SaveButtonClick(Sender: TObject);
  154. begin
  155.   {> Called from configuration panel: save parameters and go back to
  156.      execution mode as a normal application
  157.   }
  158.   write_config ;
  159.   gl_mode := rm_Normal ;
  160.   setup ;
  161. end;
  162.  
  163. procedure Tf_ScreenSaver.ExitButtonClick(Sender: TObject);
  164. begin
  165.   {> Called from configuration panel: exit the program
  166.   }
  167.   Close ;
  168. end;
  169.  
  170. procedure Tf_ScreenSaver.check_checkboxes ;
  171. begin
  172.   {> Make sure checkboxes are displayed appropriately
  173.   }
  174.   UseColorsCheckbox.visible := ShowSkyCheckbox.checked ;
  175.   UseMoreStarsCheckbox.visible := ShowSkyCheckbox.checked ;
  176.   TransparentCheckbox.visible := ShowSkyCheckbox.checked ;
  177. end ;
  178.  
  179. procedure Tf_ScreenSaver.ShowSkyCheckBoxClick(Sender: TObject);
  180. begin
  181.   {> Adjust other checkboxes when this one changes status from
  182.      checked to unchecked or vice-versa
  183.   }
  184.   check_checkboxes ;
  185. end;
  186.  
  187. {> Routines to read and write the configuration parameters block
  188. }
  189.  
  190. function Tf_ScreenSaver.WinDir : string ;
  191. var WindowsDirectory : string [100] ;
  192.     length : integer ;
  193. begin
  194.   length := GetWindowsDirectory (@WindowsDirectory [1], 100) ;
  195.   if length = 0 then halt ;
  196.   WindowsDirectory [0] := chr (length) ;
  197.   WinDir := WindowsDirectory + '\' ;
  198. end ;
  199.  
  200. procedure Tf_ScreenSaver.read_config ;
  201. var f : file of config_params ;
  202. begin
  203.   {> Read back parameters file
  204.   }
  205.   AssignFile (f, WinDir + INIT_FILE) ;
  206.   try
  207.     Reset(f) ;
  208.     Read (f, gl_params) ;
  209.     CloseFile (f) ;
  210.   except
  211.     {> OOps, file not there or wrong record size, so use
  212.        default values for the parameters instead
  213.     }
  214.     gl_params.fast := False ;
  215.     gl_params.show_sky := True ;
  216.     gl_params.use_colors := False ;
  217.     gl_params.use_more_stars := False ;
  218.     gl_params.transparent := False ;
  219.     {> Params used in normal mode only
  220.     }
  221.     gl_params.x := 50 ;
  222.     gl_params.y := 50 ;
  223.     gl_params.width := earth.width * 2 ;
  224.     gl_params.height := earth.height * 2 ;
  225.   end ;
  226. end ;
  227.  
  228. procedure Tf_ScreenSaver.write_config ;
  229. var f : file of config_params ;
  230. begin
  231.   {> Write back current parameters to file
  232.   }
  233.   if gl_mode in [rm_ConfigWindows, rm_ConfigNormal] then
  234.   begin
  235.     gl_params.fast := FastCheckbox.checked ;
  236.     gl_params.show_sky := ShowSkyCheckbox.checked ;
  237.     gl_params.use_colors := UseColorsCheckbox.checked ;
  238.     gl_params.use_more_stars := UseMoreStarsCheckbox.checked ;
  239.     gl_params.transparent := TransparentCheckbox.checked ;
  240.   end ;
  241.  
  242.   if gl_mode = rm_Normal then
  243.   begin
  244.     gl_params.x := Lef